MODULE atominfo 
! Copyright (C) 2010 W. Wang 
! License: This file is distributed under the terms of the GNU General Public License.
! Description: ! The standard information of each atom.
! Revision histoty: Created May 2010  
! Input/output Parameters: 

IMPLICIT NONE

TYPE :: atom_info

CHARACTER(2) :: atom_symbol
INTEGER :: atom_num
real(8) :: atom_mass
REAl(8):: atom_pos(3)
REAL(8) :: atom_radius
CHARACTER(10) :: atom_pot
REAL(8):: atom_magmom=0

END TYPE atom_info

END MODULE
MODULE cellinfo
! Copyright (C) 2009-2010 W. Wang 
! License: This file is distributed under the terms of the GNU General Public License.
! Description: ! 
! Revision histoty: Created May 2010  
! Input/output Parameters: 
USE atominfo
IMPLICIT NONE

!Local variables
INTEGER :: atoms
TYPE (atom_info), ALLOCATABLE :: atoms_info(:)
REAL(8) :: cell_vector(3,3)
REAL(8) :: recip_vector(3,3)
REAL(8) :: cell_vol
REAL(8) :: recip_vol


END MODULE
MODULE constants 
! Copyright (C) 2009-2010 W. Wang 
! License: This file is distributed under the terms of the GNU General Public License.
! Description: ! 
! Revision histoty: Created May 2010  
! Input/output Parameters: 

IMPLICIT NONE

!Local variables  
REAL(8),PARAMETER :: PI=3.1415926




END MODULE
SUBROUTINE cross_ab(x,y,z)
! Copyright (C) 2009 W. Wang
! This file is distributed under the terms of the GNU General Public License.
! See the file COPYING for license details.
IMPLICIT NONE
! z=(x)X(y)
REAL(8), INTENT(IN) :: x(3)
REAL(8), INTENT(IN) :: y(3)
REAL(8), INTENT(OUT) :: z(3)
z(1)=x(2)*y(3)-x(3)*y(2)
z(2)=x(3)*y(1)-x(1)*y(3)
z(3)=x(1)*y(2)-x(2)*y(1)
RETURN
END SUBROUTINE

SUBROUTINE dot_ab(a,b,ab)
! Copyright (C) 2010 W. Wang
! This file is distributed under the terms of the GNU General Public License.
! See the file COPYING for license details.

IMPLICIT NONE
REAL(8),INTENT(IN) :: a(3),b(3)
REAL(8),INTENT(OUT) :: ab
INTEGER :: i
DO i=1,3
ab=a(i)*b(i)+ab
END DO
RETURN
END SUBROUTINE

SUBROUTINE err_open(err,msg) 
! Copyright (C) 2009-2010 W. Wang 
! License: This file is distributed under the terms of the GNU General Public License.
! Description: ! 
! Revision histoty: Created May 2010  
! Input/output Parameters: 

IMPLICIT NONE
!Local variables  
INTEGER :: err
CHARACTER(100) :: msg
IF (err.GT.0) THEN
  WRITE(*,*)
  WRITE(*,'("Error opening file: ",10A)')TRIM(msg)
  WRITE(*,*)
  STOP
END IF

RETURN
END SUBROUTINE
SUBROUTINE err_read(err,msg) 
! Copyright (C) 2009-2010 W. Wang 
! License: This file is distributed under the terms of the GNU General Public License.
! Description: ! 
! Revision histoty: Created May 2010  
! Input/output Parameters: 

IMPLICIT NONE
!Local variables  
INTEGER :: err
CHARACTER(100) :: msg
IF (err.GT.0) THEN
  WRITE(*,*)
  WRITE(*,'("Error reading: ",10A)')TRIM(msg)
  WRITE(*,*)
  STOP
END IF

RETURN
END SUBROUTINE
MODULE k_space
! Copyright (C) 2009-2010 W. Wang 
! License: This file is distributed under the terms of the GNU General Public License.
! Description: ! 
! Revision histoty: Created May 2010  
! Input/output Parameters: 

IMPLICIT NONE

!Local variables  
REAL(8) :: cutoff
INTEGER :: kmesh(3)



END MODULE
PROGRAM eskit 
! Copyright (C) 2009-2010 W. Wang 
! License: This file is distributed under the terms of the GNU General Public License.
! Description: ! 
! Revision histoty: Created May 2010  
! Input/output Parameters: 

USE cellinfo 
USE k_space
IMPLICIT NONE

!Local variables  
CALL readin
CALL reciplat(cell_vector,cell_vol,recip_vol,recip_vector)
CALL writelog

!Debug
!write(*,*)atoms_info(1)%atom_symbol
!write(*,*)atoms_info(2)%atom_pos(:)
!write(*,*)cell_vector(1,:)
CALL free_memory
END 
SUBROUTINE free_memory
! Copyright (C) 2009-2010 W. Wang 
! License: This file is distributed under the terms of the GNU General Public License.
! Description: ! 
! Revision histoty: Created May 2010  
! Input/output Parameters: 

USE cellinfo
 
IMPLICIT NONE

!Local variables  
IF (AllOCATED(atoms_info)) DEALLOCATE(atoms_info)



RETURN
END SUBROUTINE
SUBROUTINE readin 
! Copyright (C) 2009-2010 W. Wang 
! License: This file is distributed under the terms of the GNU General Public License.
! Description: ! 
! Revision histoty: Created May 2010  
! Input/output Parameters: 

USE cellinfo
USE k_space
IMPLICIT NONE
!Local variables  
INTEGER :: i,j
INTEGER :: err
CHARACTER(256) :: block
OPEN(50,FILE='panda.in',ACTION='READ',STATUS='OLD',FORM='FORMATTED',IOSTAT=err)
CALL err_open(err,"panda.in")

DO
READ(50,*,IOSTAT=err) block
!write(*,*)block
IF (err.NE.0) EXIT

! read input parameters 
SELECT CASE(TRIM(block))
!CASE('tasks')
CASE('atoms')
READ(50,*,IOSTAT=err)atoms
  IF (AllOCATED(atoms_info)) DEALLOCATE(atoms_info)
  ALLOCATE(atoms_info(atoms))

  DO i=1,atoms
     READ(50,*,IOSTAT=err) atoms_info(i)%atom_symbol,(atoms_info(i)%atom_pos(j),j=1,3)
     CALL err_read(err,"atoms")
  END DO

CASE('cell')
  DO i=1,3
  READ(50,*,IOSTAT=err)(cell_vector(i,j),j=1,3)
  CALL err_read(err,"cell")
  END DO
CASE('cutoff')
  READ(50,*,IOSTAT=err)cutoff
  CALL err_read(err,"cutoff")
CASE('kmesh')
  READ(50,*,IOSTAT=err)(kmesh(i),i=1,3)
  CALL err_read(err,"kmesh")

CASE DEFAULT
END SELECT

END DO
CLOSE(50)

RETURN
END SUBROUTINE
SUBROUTINE reciplat(cell_shape,cell_vol,recip_vol,recip_shape)
! Copyright (C) 2009 W. Wang
! This file is distributed under the terms of the GNU General Public License.
! See the file COPYING for license details.

IMPLICIT NONE
REAL(8),INTENT(IN) :: cell_shape(3,3)
REAL(8),INTENT(OUT) :: recip_shape(3,3),cell_vol,recip_vol
REAL(8),PARAMETER :: PI=3.1415926

!local variables
REAL(8) :: CrossAB
CALL cross_ab(cell_shape(1,:),cell_shape(2,:),CrossAB)
CALL dot_ab(CrossAB,cell_shape(3,:),cell_vol)
recip_vol=2*PI/cell_vol
CALL cross_ab(cell_shape(2,:),cell_shape(3,:),recip_shape(1,:))
CALL cross_ab(cell_shape(3,:),cell_shape(1,:),recip_shape(2,:))
CALL cross_ab(cell_shape(1,:),cell_shape(2,:),recip_shape(3,:))

recip_shape(:,:)=recip_vol*recip_shape(:,:)
RETURN
END SUBROUTINE
SUBROUTINE 
! Copyright (C) 2009-2010 W. Wang 
! License: This file is distributed under the terms of the GNU General Public License.
! Description: ! 
! Revision histoty: Created May 2010  
! Input/output Parameters: 

USE readmod 
IMPLICIT NONE

!Local variables  




RETURN
END SUBROUTINE
SUBROUTINE writelog
! Copyright (C) 2009-2010 W. Wang 
! License: This file is distributed under the terms of the GNU General Public License.
! Description: ! 
! Revision histoty: Created May 2010  
! Input/output Parameters: 

USE cellinfo 
USE k_space
IMPLICIT NONE
CHARACTER(8) :: logname="LOG.OUT"
INTEGER :: i,j
CHARACTER(24) :: date

OPEN(11,FILE=TRIM(logname))
CALL fdate(date)
WRITE(11,*)date
WRITE(11,*)
WRITE(11,*)"+-------------------------------------------+"
WRITE(11,*)"|            General Parameters             |"
WRITE(11,*)"+-------------------------------------------+"
WRITE(11,*)
WRITE(11,*)"Atomic Species and Fractional-coordinates:"
DO i=1,atoms
WRITE(11,100)atoms_info(i)%atom_symbol,(atoms_info(i)%atom_pos(j),j=1,3)
100 FORMAT (A3,3F13.7)
END DO
WRITE(11,*)
WRITE(11,*)"Lattice vectors:"
WRITE(11,"(3F14.8)")((cell_vector(i,j),i=1,3),j=1,3)
WRITE(11,*)
WRITE(11,*)"Reciprocal vectors:"
WRITE(11,"(3F14.8)")((Recip_vector(i,j),i=1,3),j=1,3)
WRITE(11,*)
WRITE(11,"(A24,F14.8)")"Unit cell volume      :",abs(cell_vol)
WRITE(11,"(A24,F14.8)")"Brillouin zone volume :",abs(recip_vol)

WRITE(11,*)
WRITE(11,"(A9,F8.2)")"Cutoff: ",cutoff
WRITE(11,*)
WRITE(11,"(A8,3I2)")"Kmesh: ", (kmesh(i),i=1,3)
CLOSE(11)

!Local variables  




RETURN
END SUBROUTINE
